home *** CD-ROM | disk | FTP | other *** search
/ Mac Magazin/MacEasy 2 / Mac Magazin and MacEasy Magazine CD - Issue 02.iso / Sharewarebibliothek / Applikationen / Alpha.5.81 folder / Tcl / UserCode / MacPerl.tcl < prev    next >
Text File  |  1994-06-12  |  16KB  |  528 lines
  1. #############################################################################
  2. # MacPerl.tcl
  3. #
  4. # This is a set of routines that allow Alpha to act as a front end for the
  5. # standalone MacPerl application and that allows Perl scripts to be used as 
  6. # text filters in Alpha.
  7. #
  8. #     !!!  This package requires Alpha version 5.75 or higher  !!!
  9. #
  10. #############################################################################
  11. # Features:
  12. #
  13. # A Perl menu is created that allows the following actions:
  14. #
  15. # 1.  Selected text (or the entire buffer) may be interpreted as a Perl 
  16. #     script by MacPerl.
  17. #    
  18. # 2.  A selected Perl script file may be executed by MacPerl.
  19. #
  20. # 3.  Perl scripts that read from standard input and write to standard
  21. #     output my be used as text filters within Alpha.  
  22. #
  23. #     A submenu of "preattached" Perl scripts is constructed from the 
  24. #     contents of a "Text Filters" folder within the main MacPerl folder.
  25. #     This folder will be created if it doesn't already exist.
  26. #
  27. #     Besides the "preattached" filters, a disk file or an Alpha buffer
  28. #     which contains a Perl script may be chosen as the text filter.
  29. #     (The latter option allows simple one-time scripts to be created and 
  30. #     applied on the fly.  This can be very useful because, even
  31. #     with the overhead to start up MacPerl, large-scale global search-
  32. #     and-replace operations (hundreds of replaces) are substantially faster
  33. #     in MacPerl than in Alpha.)
  34. #
  35. #     The output of Perl text filters may be chosen to overwrite the 
  36. #     selected Alpha text or else written into a new window.  (Everything 
  37. #     is undoable, in any case).
  38. #
  39. #     The filter may be applied either to the currently selected text
  40. #     or to the entire buffer.
  41. #
  42. # 4.  The temporary i/o files used by the text filter mechanism may be 
  43. #     examined.
  44. #
  45. # 5.  The Perl menu may be rebuilt, in case files are added or removed 
  46. #     from the "Text Filters" folder.
  47. #
  48. #############################################################################
  49. # Installation:
  50. #
  51. # This file must be placed in the folder where you keep local Tcl 
  52. # procedures.  The following lines should be added to your 
  53. # 'userStartup.tcl' file (in the Alpha home directory), with the 
  54. # appropriate path names for your own system.
  55. # 
  56. #     set macperlPath "Macintosh HD:Programming:MacPerl ƒ:MacPerl"
  57. #     source  ":Tcl:Local:MacPerl.tcl"
  58. #
  59. # A sampling of useful :-) Perl scripts are included in the folder "Text Filters".
  60. # You should drag this folder into your MacPerl folder, where MacPerl.tcl will
  61. # look for it.  The "Text Munging" scripts are largely from the Nutshell book 
  62. # ("Programming Perl") and the s2p script is my adaptation of the standard script 
  63. # that converts Unix "sed" scripts to Perl.  The others may be useful examples, 
  64. # as well.
  65. #
  66. # ...........................................................................
  67. #
  68. # If you don't already have MacPerl, it's available by anonymous ftp from
  69. # a number of sites, of which the most accessible seem to be
  70. #
  71. #  grind.isca.uiowa.edu [128.255.21.233]   
  72. #                                 mac/umich/development/languages/macperl4.12.sit
  73. #
  74. #  nic.switch.ch [130.59.1.40]    software/mac/perl/Mac_Perl_412_appl.sit.bin
  75. #
  76. #############################################################################
  77. # Authors: W. Thomas Pollard (pollard@cucbs.chem.columbia.edu)
  78. #          Martijn Koster (m.koster@nexor.co.uk)
  79. #
  80. # Version History:
  81. #
  82. # 0.7  3/94 WTP -  nested Text Filters folder now supported
  83. #                  menu format modified somewhat
  84. # 0.6  3/94 WTP -  'applyToBuffer' flag added
  85. #                  scripts in Alpha buffers can now be used as filters 
  86. # 0.5  2/94 WTP -  'filters', 'open special' submenu added
  87. #                  'overwrite' flag added
  88. # 0.2  1/94 MK  -  menu support added
  89. #                  'execute selection', 'execute buffer' commands added
  90. # 0.1  9/93 WTP -  text filter functionality created
  91. #                  
  92. #############################################################################
  93.  
  94. global perlMenu macperlPath perlOverwrite perlUsebuffer
  95.  
  96. set perlOverwrite 1
  97. set perlUsebuffer 1
  98.  
  99. #############################################################################
  100. #  Return paths to standard files, based on the path to MacPerl:
  101. #  (This should make it easier to move MacPerl, install new versions,
  102. #  etc., without breaking the scripts.
  103. #
  104. proc macperlFolder {} {
  105.    global macperlPath
  106.    regexp {(.*):([^:]*)} $macperlPath pathname dirname filename
  107.    return ${dirname}:
  108. }
  109.  
  110. proc stdinPath {} {
  111.    return [macperlFolder]STDIN
  112. }
  113.  
  114. proc stdoutPath {} {
  115.    return [macperlFolder]STDOUT
  116. }
  117.  
  118. proc scriptPath {} {
  119.    return [macperlFolder]SCRIPT
  120. }
  121.  
  122. proc scriptFolder {} {
  123.    return "[macperlFolder]Text Filters:"
  124. }
  125.  
  126. #############################################################################
  127. #  Set the "overwrite" flag.  If true, then the output of a Perl filter
  128. #  is inserted in place of the originally selected text.  Otherwise, it is
  129. #  placed in a new window.  The names of the routines reflect the condition
  130. #  of the flag _before_ the routine is called, so that the menu makes more
  131. #  sense.
  132. # 
  133. proc •OverwriteSelection {} {
  134.     global perlOverwrite
  135.     set perlOverwrite 0
  136.     rebuildPerlMenu
  137. }
  138.  
  139. proc •Don\'tOverwriteSelection {} {
  140.     global perlOverwrite
  141.     set perlOverwrite 1
  142.     rebuildPerlMenu
  143. }
  144.  
  145. #############################################################################
  146. #  Set the "usebuffer" flag.  If true, then the Perl filter is applied to 
  147. #  the entire buffer.  Otherwise, only the selected text is filtered.
  148. # 
  149. proc •ApplyToBuffer {} {
  150.     global perlUsebuffer
  151.     set perlUsebuffer 0
  152.     rebuildPerlMenu
  153. }
  154.  
  155. proc •ApplyToSelection {} {
  156.     global perlUsebuffer
  157.     set perlUsebuffer 1
  158.     rebuildPerlMenu
  159. }
  160.  
  161. #############################################################################
  162. #  This is a generally useful proc that builds a hierarchical menu 
  163. #  from the files in a given folder and all subfolders.  As the menu is
  164. #  built, the pathnames of the various files are saved in the array
  165. #  indicated  by $filePaths.  The index of the file's path in this array
  166. #  is formed by concatenating the submenu name and filename, allowing the
  167. #  pathname to be retrieved by the procedure $proc when the menu item is
  168. #  selected.
  169. #
  170. proc buildSubMenu {folder name proc filePaths} {
  171.     global $filePaths
  172.     if {$name == 0} {
  173.         set name [file tail [file dirname $folder]]
  174.     }
  175.     if {$proc == 0} {
  176.         set pproc ""
  177.     } else {
  178.         set pproc "-p $proc"
  179.     }
  180.     set menu {}
  181.     set filenames [glob -nocomplain  $folder\*]
  182.     if {[llength $filenames] > 0} {
  183.        foreach m $filenames {
  184.           if {[file isdirectory $m]} {
  185.               lappend menu [buildSubMenu ${m}: 0 $proc $filePaths] 
  186.           } elseif {[file isfile $m]} {
  187.               set fname [file tail $m]
  188.               lappend menu $fname
  189.               set ${filePaths}($name:$fname) $m
  190.           }
  191.          }
  192.     }
  193.     return [concat {menu -m -n} [list $name] $pproc [list $menu]]
  194. }
  195.  
  196. #############################################################################
  197. #  Build a submenu of "preattached" Perl filters using the names of the 
  198. #  scripts in the Text Filters directory
  199. #
  200. proc perlFilterMenu {} {
  201.     global perlFilterPath HOME
  202.     set scriptDir [scriptFolder]
  203.     if {![file exists $scriptDir]} {
  204.        cpdir "$HOME:Tcl:UserCode:Text Filters" [macperlFolder]
  205.        alertnote "Created \"[macperlFolder]Text Filters\" folder."
  206.     }
  207.     return [buildSubMenu $scriptDir TextFilters perlExecuteFilter perlFilterPath]
  208. }
  209.  
  210. proc rebuildPerlMenu {} {
  211.     global perlMenu perlOverwrite perlUsebuffer
  212.     
  213.     if {$perlOverwrite} {
  214.             set overwriteItem •OverwriteSelection 
  215.         } else {
  216.             set overwriteItem •Don\'tOverwriteSelection 
  217.         }
  218.     
  219.     if {$perlUsebuffer} {
  220.             set usebufferItem •ApplyToBuffer 
  221.         } else {
  222.             set usebufferItem •ApplyToSelection 
  223.         }
  224.     
  225.     menu -n $perlMenu [ concat {
  226.         "macperl"
  227.         "(-"
  228.         "runTheSelection"
  229.         "runTheBuffer"
  230.         "runAFile"
  231.         "(-"
  232.         } [list [perlFilterMenu]] {
  233.         {menu -n OtherTextFilters {
  234.            "selectABuffer"
  235.            "selectAFile"
  236.            }
  237.         } 
  238.         } $overwriteItem  {
  239.         } $usebufferItem  {
  240.         "(-"
  241.         {menu -m -n openSpecial -p perlOpenFile {
  242.            "STDIN"
  243.            "STDOUT"
  244.            "SCRIPT"
  245.            }
  246.         } 
  247.         "(-"
  248.         "rebuildPerlMenu"
  249.         } ]
  250.  
  251.     removeMenu $perlMenu
  252.     insertMenu $perlMenu
  253. }
  254.  
  255. rebuildPerlMenu
  256.  
  257. #############################################################################
  258. # Switch to MacPerl:
  259. # 
  260. proc macperl {} {
  261.     global macperlPath
  262.     set name [checkRunning MacPerl McPL macperlPath]
  263.     if {[string length $name]} {
  264.         switchTo "MacPerl"
  265.     } else {
  266.         alertnote "Couldn't run MacPerl"
  267.     }
  268. }
  269.  
  270. #############################################################################
  271. #
  272. proc perlOpenFile {menu name} {
  273.     set filename [macperlFolder]$name
  274.     if {[file exists $filename]} {
  275.         edit $filename
  276.     } else {
  277.         alertnote "That file doesn't exist yet"
  278.     }
  279. }
  280.  
  281. #############################################################################
  282. # Get a script file to run under MacPerl:
  283. #
  284. proc runAFile {} {
  285.     if {! [catch {getfile "Select a Perl script:"} path]} {
  286.             perlExecuteFile $path
  287.     }
  288. }
  289.  
  290. #############################################################################
  291. # Tell MacPerl to run a script file:
  292. #
  293. proc ExecuteFile {path} {
  294.     global macperlPath
  295.     if {[string length $path]} {
  296.         set name [checkRunning MacPerl McPL macperlPath]
  297.         if {[string length $name]} {
  298.             dosc -c 'McPL' -r -f $path
  299.             switchTo "MacPerl"
  300.         } else {
  301.             alertnote "Couldn't run MacPerl"
  302.         }
  303.     } else {
  304.             alertnote "No file specified to execute"
  305.     }
  306. }
  307.  
  308. #############################################################################
  309. # Run the buffer as a MacPerl script:
  310. #
  311. proc runTheBuffer {} {
  312.     perlExecuteScript [getText 0 [maxPos]]
  313. }
  314.  
  315. #############################################################################
  316. # Run the selection as a MacPerl script:
  317. # (No special arrangements are made to provide input or capture the output)
  318. # 
  319. proc runTheSelection {} {
  320.     completeSelection
  321.     perlExecuteScript [getSelect]
  322. }
  323.  
  324. #############################################################################
  325. # Run a MacPerl script file.
  326. # (No special arrangements are made to provide input or capture the output)
  327. # 
  328. proc perlExecuteFile {fname} {
  329.     set fd [open $fname "r"]
  330.     perlExecuteScript [read $fd]
  331.     close $fd
  332. }
  333.  
  334. #############################################################################
  335. # Run a MacPerl script, passed explicitly as a string:
  336. # (No special arrangements are made to provide input or capture the output)
  337. # 
  338. proc perlExecuteScript {script} {
  339.     global macperlPath
  340.     if {$script != ""} {
  341.         set name [checkRunning MacPerl McPL macperlPath]
  342.         if {[string length $name]} {
  343.             dosc -c 'McPL' -r -s $script
  344.             switchTo "MacPerl"
  345.        } else {
  346.             alertnote "Couldn't run MacPerl"
  347.        }
  348.     } else {
  349.         alertnote "Empty script"
  350.     }
  351. }
  352.  
  353. #############################################################################
  354. # Run a Perl script filter selected from the menu:
  355. #
  356. proc perlExecuteFilter {menu name} {
  357.     global perlFilterPath
  358.     set path $perlFilterPath($menu:$name)
  359. #    set path [scriptFolder]$name
  360.     set coreScript [readFile $path]
  361.     if {$coreScript != -1} {
  362.         set script [wrapFilterScript $coreScript]
  363.         filterThruMacperl $script
  364.     } else {
  365.         alertnote "Couldn't read the script file : $path"
  366.         return
  367.     }
  368. }
  369.  
  370. #############################################################################
  371. # Ask for a file containing a Perl script to use as a filter:
  372. #
  373. proc selectAFile {} {
  374.     if {! [catch {getfile "Select a MacPerl script"} path]} {
  375.         set coreScript [readFile $path]
  376.         if {$coreScript != -1} {
  377.             set script [wrapFilterScript $coreScript]
  378.             filterThruMacperl $script
  379.         } else {
  380.             alertnote "Couldn't read the script file : $path"
  381.             return
  382.         }
  383.     }
  384. }
  385.  
  386. #############################################################################
  387. # Ask for an Alpha buffer containing a Perl script to use as a filter:
  388. #
  389. proc selectABuffer {} {
  390.     set windows [winNames]
  391.     if {[llength $windows] > 1} {
  392.         set current [lindex $windows 0]
  393.         set name [listpick [lsort $windows]]
  394.         if {[string length $name]} {
  395.             bringToFront $name
  396.             set coreScript [getText 0 [maxPos]]
  397.             if {[string length $coreScript]} {
  398.                 set script [wrapFilterScript $coreScript]
  399.                 bringToFront $current
  400.                 filterThruMacperl $script
  401.             } else {
  402.                 bringToFront $current
  403.             }
  404.            }
  405.     }
  406. }
  407.  
  408. #############################################################################
  409. # Filter selection through a Perl script:
  410. # 
  411. # bugs:  If the script contains an existing !/bin/perl line, then it
  412. #        should be removed, or preferably used instead of my own new line.
  413. #
  414. proc filterThruMacperl {script} {
  415.     global macperlPath perlOverwrite perlUsebuffer
  416.  
  417.     set name [checkRunning MacPerl McPL macperlPath]
  418.     if {[string length $name]} {
  419.         writeStdin
  420.         writeStdout
  421.         dosc -c 'McPL' -t 0 -s $script
  422.     } else {
  423.         alertnote "Couldn't run MacPerl"
  424.     }
  425.     
  426.     if {!$perlOverwrite} new
  427.     if {$perlUsebuffer} {
  428.         pasteStdout 0 [maxPos]
  429.     } else {
  430.         pasteStdout [getPos] [selEnd]
  431.     }
  432. }
  433.  
  434. #############################################################################
  435. #  Take a Perl script and add commands to take the file STDIN as standard
  436. #  input and STDOUT as standard output.  This allows scripts written as
  437. #  Unix command-line filters to be used in the (non-MPW) Mac environment as
  438. #  text filters.
  439. #
  440. proc wrapFilterScript {coreScript} {
  441.  
  442.     set filterHead "#!/usr/bin/perl\n"
  443.     append filterHead "\$macperlDir = \"[macperlFolder]\" ;\n"
  444.     append filterHead "open(STDIN, \"<[stdinPath]\" ) ;\n"
  445.     append filterHead "open(STDOUT, \">[stdoutPath]\" ) ;\n"
  446.     append filterHead "@ARGV = (\"[stdinPath]\") ;\n"
  447.     append filterHead "select(STDOUT) ;\n\n"
  448.     
  449.     set filterTail "close STDIN ;\nclose STDOUT ;\n"
  450.         
  451.     set script $filterHead
  452.     append script $coreScript
  453.     append script $filterTail
  454.     
  455.     writeScript $script
  456.     return $script
  457. }        
  458.  
  459. #############################################################################
  460. #  Paste the text of the file STDOUT in place of the current selection.
  461. #
  462. proc pasteStdout {from to} {
  463.     set result [readFile [stdoutPath]]
  464.     if {$result != -1} {
  465.         deleteText $from $to
  466.         insertText $result
  467.         shrinkLow
  468.         goto 0
  469.     } else {
  470.         alertnote "Couldn't find the output file : STDOUT"
  471.     }
  472. }    
  473. #        replaceText [getPos] [selEnd] $result
  474.  
  475. #############################################################################
  476. #  Extend the current selection to encompass complete lines.
  477. #
  478. proc completeSelection {} {
  479.     global perlUsebuffer
  480.     if {$perlUsebuffer} {
  481.         set start 0
  482.         set end [maxPos]
  483.     } else {
  484.         set start [lineStart [getPos]]
  485.         set end [nextLineStart [expr [selEnd]-1]]
  486.     }
  487.     if {$end == $start} {set end [nextLineStart [selEnd]]}
  488.     select $start $end
  489. }
  490.  
  491. #############################################################################
  492. #
  493. proc writeStdin {} {
  494.     completeSelection
  495.     set tmpfid [open [stdinPath] "w+"]
  496.     puts $tmpfid [getSelect] 
  497.     close $tmpfid
  498. }
  499.  
  500. proc writeStdout {} {
  501.     completeSelection
  502.     set tmpfid [open [stdoutPath] "w+"]
  503.     puts $tmpfid [getSelect] 
  504.     close $tmpfid
  505. }
  506.  
  507. proc writeScript {script} {
  508.     set tmpfid [open [scriptPath] "w+"]
  509.     puts $tmpfid $script 
  510.     close $tmpfid
  511. }
  512.  
  513. #############################################################################
  514. #
  515. proc readFile {fileName} {
  516.     if {[file exists $fileName] && [file readable $fileName]} {
  517.        set fileid [open $fileName "r"]
  518.        set contents ""
  519.        while {[gets $fileid nextLine] != -1} {
  520.           append contents $nextLine "\n"
  521.        }
  522.        close $fileid
  523.        return $contents
  524.     } else {
  525.        return -1
  526.     }
  527. }
  528.